125

Shaping up

125

STEP 1 continued

symbol?#Addition symbol +​#Return value only; indicates a combination of the other

states.#Moon#Trapezoid with asymmetrical non-​parallel sides#No symbol#Notched

block arrow that points right#Not supported#Octagon#Oval#Oval-​shaped callout#P

arallelogram#Pentagon#Circle (‘pie’) with a portion missing#Quarter of a circular

shape#Plaque#Four quarter-​circles defining a rectangular shape#Block arrows that

point up, down, left, and right#Callout with arrows that point up, down, left, and

right#Rectangle#Rectangular callout#Pentagon#Block ar”

ConstText =​ ConstText & _​

“row that points right#Callout with arrow that points right#Right brace#Right

bracket#Right triangle#Rectangle with one rounded corner#Rectangle with two

rounded corners, diagonally-​opposed#Rectangle with two-​rounded corners that

share a side#Rounded rectangle#Rounded rectangle-​shaped callout#Smiley

face#Rectangle with one snipped corner#Rectangle with two snipped corners,

diagonally-​opposed#Rectangle with two snipped corners that share a side#Rectangle

with one snipped corner and one rounded corner#Four small squares that define a

rectangular shape#Block arrow that points right with stripes at the tail#Sun#Curved

arrow#Water droplet#Trapezoid#Block arrow that points up#Callout with arrow that

points up#Block arrow that points up and down#Callout with arrows that point up and

down#Ribbon banner with center area above ribbon ends#Block arrow forming a U

shape#Vertical scroll#Wave”

msoAutoShapeTypeDescription =​ Split(ConstText, “#”)

STEP 2

Dim sheet As Worksheet

Dim CurrentSheet As Worksheet

Set CurrentSheet =​ Application.ActiveSheet

FoundSheet =​ 0

For Each sheet In ActiveWorkbook.Worksheets

    If sheet.Name =​ “ShapeList” Then

      FoundSheet =​ 1

      Exit For

    End If

Next

If FoundSheet =​ 0 Then

    Set sheet =​ ActiveWorkbook.Sheets.Add(After:=​ActiveWorkbook.

Worksheets(ActiveWorkbook.Worksheets.Count))

    sheet.Name =​ “ShapeList”

End If

Worksheets(“ShapeList”).Cells(1, 1) =​ “AutoShapeType”

Worksheets(“ShapeList”).Cells(1, 2) =​ “Type”

Worksheets(“ShapeList”).Cells(1, 3) =​ “Name”

Worksheets(“ShapeList”).Cells(1, 4) =​ “Label”

CurrentSheet.Select

‘

    Dim shp As Shape

    kk =​ 1

    Sheets(“ShapeList”).Range(“a2:d1000”).Clear

    For Each shp In ActiveSheet.Shapes

      kk =​ kk +​ 1

      Call GetRows(kk, shp)

    Next shp